home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
CU Amiga Super CD-ROM 1
/
CU Amiga Magazine CD-ROM Special Edition (1995)(EMAP Images)(GB)[Issue 1995-11].iso
/
Aminet
/
biz
/
demo
/
StylusDemo.lha
/
Stylus_Demo
/
REXX
/
CutPath.pvrx
< prev
next >
Wrap
Text File
|
1994-05-02
|
5KB
|
188 lines
/***************************************************************************
* *
* $VER: CutPath.pvrx 3.0 (02.May.94) *
* Copyright © 1994 by Stylus, Inc. *
* Author: Jeff Blume *
* *
* This macro prompts user to select a point where a path should be cut. *
* All points AFTER selected point become new object. *
* *
* Suggested "ProVector.pvrx" entries: *
* 'Define "CutPath " "CutPath MENU"' *
* *
* *
***************************************************************************/
/*
call open STDOUT,"RAM:RxOut.txt",W
call open STDERR,"RAM:RxErr.txt",W
trace R
*/
/* Get the argument list to see whether this is a MENU, or an OK */
arg arglist
Cmd = word(arglist,1)
options results
/* Try to get exclusive lock on project window.
If can't get lock, not polite to interrupt. */
'Lock'
if RC ~= 0 then exit
/* This loop is called from the menu */
if Cmd = 'MENU' then
DO
/* Test Selected list for magnetized? */
/* Magnetize Sel Objs for better coord identification.*/
'SelectList' Sel; SelN = Result
if SelN ~= 1 then do
RC = 100
call Error "MUST SELECT ONE OBJECT ONLY!"
end
else 'Magnetize' SelN Sel
'TypeOf Sel.0'; ObjType = Result
call setclip "RepairType","" /* NULL out flag */
select
when ObjType = "Polyline" then do
'Prompt "Click One Point To Cut:"'
'GetUserData 0 1 1 "CutPath OK" ""'
end
when ObjType = "Polygon" then do
'ChangeType Sel.0 Polyline'
'Repair'
'Prompt "Click One Point To Cut:"'
'GetUserData 0 1 1 "CutPath OK" ""'
'ChangeType Sel.0 "Polygon"'
call setclip "RepairType","1"
end
otherwise do
RC = 100
call Error "CAN'T CUT TEXT OR GROUP"
end
end /* SELECT END */
END
/* end "MENU" loop */
/* This was called from GetUserData */
if Cmd = 'OK' then
DO
'EndPrompt'
'GetInputPoints Pts'; NumIn=Result /* 1 or 2 */
'PushUndo'
'Prompt "Looking for cut."'
'SelectList' Sel; SelN = Result
'TypeOf Sel.0'; ObjType = Result
'GetPoints' Sel.0 ObjPts; NumPts=Result
/* Find Cut and build first new obj (Point 1 to Cut) */
do j = 0 to NumPts-1
select
when ObjPts.j.X = Pts.0.X & ObjPts.j.Y = Pts.0.Y then
do
ObjPtsA.j.X = ObjPts.j.X
ObjPtsA.j.Y = ObjPts.j.Y
Cut = j + 1 /* Clicked point stays with first part */
NumPtsB = NumPts - j - 1
if NumPtsB = 1 then do
RC = 100
call Error "CAN'T CUT 2ND TO LAST!"
end
if Cut = NumPts then do
RC = 100
call Error "CAN'T CUT LAST POINT!"
end
if Cut = 1 then do
RC = 100
call Error "CAN'T CUT FIRST POINT!"
end
call NoBeziers ObjPts,Cut
leave j
end
when j = NumPts-1 & Cut = "Cut" then do
RC = 100
call Error "CAN'T FIND CUT!"
end
otherwise do
ObjPtsA.j.X = ObjPts.j.X
ObjPtsA.j.Y = ObjPts.j.Y
end
end /* SELECT END */
end /* "j" DO END */
if ObjType = "Polyline" then 'Polyline' Cut ObjPtsA
else 'Polygon' Cut ObjPtsA
/* Build second new obj (Cut to Point N) */
/* Discard first point if Sub-Poly Indicator
(all other indicators already trapped) */
if ObjPts.Cut.X = "INDICATOR" then do
Cut = Cut+1
NumPtsB = NumPtsB-1
end
do j = Cut to NumPts - 1
k = j - Cut
ObjPtsB.k.X = ObjPts.j.X
ObjPtsB.k.Y = ObjPts.j.Y
end
if ObjType = "Polyline" then 'Polyline' NumPtsB ObjPtsB
else 'Polygon' NumPtsB ObjPtsB
SAY "POLYGON RC = "||RC
TRACE ?R
/* De-Magnetize and Delete original obj; otherwise cleanup */
/* SelN = 0 */
'Magnetize' 0 Sel
'Delete' Sel.0
'EndPrompt'
'Repair'
END
/* end "OK" loop */
'UnLock'
EXIT
ERROR:
arg ErrTxt
if RC ~= 0 & ErrTxt ~= "" then 'GetBool ErrTxt "Cancel" "Cancel"'
SelN = 0
'Magnetize' SelN Sel
'EndPrompt'
if getclip("RepairType")=1 then 'Repair'
'UnLock'
EXIT
NOBEZIERS: /* NO BEZIERS ON THIS BUS! (can't cut 'em) */
arg ObjPts,Cut
do t = Cut-2 to Cut-4 by -1 /* Cut OK at last pt of curve */
if ObjPts.t.X = "INDICATOR" & (ObjPts.t.Y = "1" | ObjPts.t.Y = "3") then do
RC = 100
call Error "Can't Cut Curves!"
end
if ObjPts.t.X = "INDICATOR" & ObjPts.t.Y = "2" then do
RC = 100
call Error "Can't Cut Sub-Poly Here"
/* Well, you could if macro supported it */
end
end
return
FINDCUT:
arg Point,ObjPts,NumPts
do j = 0 to NumPts-1
select
when ObjPts.j.X = Point.X & ObjPts.j.Y = Point.Y then
do
Idx.k = j
NmPts.k = NumPts
return ObjPts.j
end
when j = NumPts-1 then return "NO POINT"
otherwise iterate
end /*SELECT END*/
end /* "j" DO END */